VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CDataAccess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Copyright (C) 1998 Microsoft Corporation
'All rights reserved.
'
'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
'EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
'MERCHANTIBILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
'Date    - 06/01/98
'Authors - Robert Coleridge, Steve Kirk, Dale Smith, Michael Zonczyk
'
Option Explicit

Private m_bInsideTransaction As Boolean

Private Const OBJNAME = "DataAccessAPI"
Private Const scSHAPE_PROVIDER = "MSDataShape"

Private m_oConnection As ADODB.Connection

Public Enum QUERYOPTIONS
    QO_UseTable = ADODB.adCmdTable
    QO_UseText = ADODB.adCmdText
    QO_UseStoredProc = ADODB.adCmdStoredProc
    QO_UseUnknown = ADODB.adCmdUnknown
    QO_UseDefault = -1
End Enum

Public Enum LOCKTYPES
    LT_ReadOnly = ADODB.adLockReadOnly
    LT_Optimistic = ADODB.adLockOptimistic
    LT_Pessimistic = ADODB.adLockPessimistic
    LT_BatchOptimistic = ADODB.adLockBatchOptimistic
End Enum

Public Enum RECORDSETTYPES
    RT_Disconnected
    RT_Connected
End Enum
'=======================================================================
'Synopsis:              This function begins a new transaction
'Function input:        none
'Function output:       Returns TRUE if the function succeeds
'Remarks
'=======================================================================
Public Function BeginTrans() As Boolean
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    BeginTrans = False
    m_bInsideTransaction = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'signal beginning of transaction
    m_oConnection.BeginTrans
        
    'signal transactional success
    m_bInsideTransaction = True
    
    'we're out of here
    BeginTrans = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:

    'store incoming values and raise error
    lErrNo = Err.Number
    sErrDesc = Err.Description
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              This function closes a previously opened connection
'Function input:        none
'Function output:       Returns TRUE if the function succeeds
'Remarks
'=======================================================================
Public Function CloseConnection() As Boolean

    If Not m_oConnection Is Nothing Then
        m_oConnection.Close
        Set m_oConnection = Nothing
    End If

End Function

'=======================================================================
'Synopsis:              This function commits a previously begun transaction
'Function input:        Connect string which is a registered DSN. If supplied
'                       then previously established connection is closed
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function CommitTrans() As Boolean
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    CommitTrans = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'commit the transaction
    m_oConnection.CommitTrans
    
    'signal closure of transaction, success of function and we're out of here
    m_bInsideTransaction = False
    CommitTrans = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values and raise error
    lErrNo = Err.Number
    sErrDesc = Err.Description
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              This function closes a connected recordset
'Function input:        Recordset to be disconnected
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function DisconnectRecordset(ByRef Recordset As ADODB.Recordset) As Boolean
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    DisconnectRecordset = False

    'enable error handler
    On Error GoTo ErrorHandler
    
    'diconnect the recordseyt
    Recordset.Close
    Set Recordset.ActiveConnection = Nothing
    
    'signal closure of transaction, success of function and we're out of here
    DisconnectRecordset = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values and raise error
    lErrNo = Err.Number
    sErrDesc = Err.Description
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              This function opens a connection using ADO and
'                       executes the action query passed to it.
'Function input:        Connect string which is a registered DSN
'                       Query string to be executed.
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function ExecQuery( _
                    ByVal Connect As String, _
                    ByVal SQLQuery As String) As Boolean
Dim oConn       As ADODB.Connection
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    ExecQuery = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'Get connection
    If Connect <> vbNullString Then
        Set oConn = New ADODB.Connection
        oConn.Open Connect
    Else
        Set oConn = m_oConnection
    End If
    
    'set up for transaction, execute query, commit transaction, and clean up
    oConn.Execute SQLQuery, , adExecuteNoRecords
    If Connect <> vbNullString Then
        oConn.Close
    End If
    Set oConn = Nothing
    
    'signal success of function and we're out of here
    ExecQuery = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values
    lErrNo = Err.Number
    sErrDesc = Err.Description

    'close connection, and raise error
    On Error Resume Next
    If Connect <> vbNullString Then
        oConn.Close
    End If
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc
    
End Function

'=======================================================================
'Synopsis:              Function opens a connection using ADO and executes
'                       a query passed to it. This function returns
'                       records in a CONNECTED recordset.
'Function input:        Query string to be executed.
'                       A recordset to return records in
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function GetConnectedRecordset( _
                    ByVal SQLQuery As String, _
                    ByRef Recordset As ADODB.Recordset, _
                    Optional ByVal LockType As LOCKTYPES = LT_Optimistic, _
                    Optional ByVal Options As QUERYOPTIONS = QO_UseText) _
                    As Boolean
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    GetConnectedRecordset = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'lock as a batch if no lock type specified
    If LockType = 0 Then
        LockType = adLockBatchOptimistic
    End If
    
    'set up query
    Set Recordset = New ADODB.Recordset
    Recordset.ActiveConnection = m_oConnection
    Recordset.CursorType = adOpenKeyset
    Recordset.LockType = LockType
    Recordset.CursorLocation = adUseClient
    'execute query and get recordset
    Recordset.Open SQLQuery, , , , Options
    
    'signal success of function and we're out of here
    GetConnectedRecordset = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values
    lErrNo = Err.Number
    sErrDesc = Err.Description
    
    'close down what we can and raise error
    On Error Resume Next
    Set Recordset = Nothing
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              Function opens a connection using ADO and executes
'                       a query passed to it. This function returns
'                       records in a DISCONNECTED recordset.
'Function input:        Connect string which is a registered DSN
'                       Query string to be executed.
'                       A recordset to return records in
'                       optional parameters for ADO
'                       optional shape provider toggle
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function GetRecordset( _
                    ByVal Connect As String, _
                    ByVal SQLQuery As String, _
                    ByRef Recordset As ADODB.Recordset, _
                    Optional ByVal Options As QUERYOPTIONS = QO_UseText, _
                    Optional ByVal UseShapeProvider As Boolean = False) _
                    As Boolean
Dim oConn       As ADODB.Connection
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    GetRecordset = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'Get connection and set up for recordset
    If Connect <> vbNullString Then
        Set oConn = New ADODB.Connection
        'provider for shaped recordsets (Note! Forces client side cursor)
        If UseShapeProvider Then
            oConn.Provider = scSHAPE_PROVIDER
        End If
        oConn.Open Connect
    Else
        Set oConn = m_oConnection
    End If
        
    'set up query
    Set Recordset = New ADODB.Recordset
    Set Recordset.ActiveConnection = oConn
    Recordset.CursorLocation = adUseClient
    Recordset.CursorType = adOpenStatic
    Recordset.LockType = adLockBatchOptimistic
    'Recordset.LockType = adLockReadOnly
    'Recordset.StayInSync = False
    
    'execute query and get recordset
    Recordset.Open SQLQuery, , , , Options
    
    'clean up
    Set Recordset.ActiveConnection = Nothing

    If Connect <> vbNullString Then
        oConn.Close
    End If
    
    Set oConn = Nothing
    
    'signal success of function and we're out of here
    GetRecordset = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values
    lErrNo = Err.Number
    sErrDesc = Err.Description
    
    'close down what we can and raise error
    On Error Resume Next
    Set Recordset = Nothing
    On Error GoTo 0
    If Connect <> vbNullString Then
        oConn.Close
    End If
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              Function returns a boolean flag indicating whether
'                       a transacted connection is in progress
'Function output:       Returns TRUE if transacted connection
'=======================================================================
Public Property Get IsInTransaction() As Boolean
    
    IsInTransaction = m_bInsideTransaction

End Property

'=======================================================================
'Synopsis:              This function creates and opens a new connection
'Function input:        Connect string which is a registered DSN
'Function output:       Returns TRUE if the function succeeds
'Remarks
'=======================================================================
Public Function OpenConnection(ByVal Connect As String) As Boolean
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    OpenConnection = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'establish the transaction if DSN specified
    If Connect <> vbNullString Then
        CloseConnection
        Set m_oConnection = New ADODB.Connection
        m_oConnection.Open Connect
    End If
    
    'we're out of here
    OpenConnection = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:

    'store incoming values and raise error
    lErrNo = Err.Number
    sErrDesc = Err.Description
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              Function opens a connection using ADO and updates the database
'                       using a passed in recordset
'Function input:        Connect string which is a registered DSN
'                       A recordset to update database with
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function PutRecordset( _
                    ByVal Connect As String, _
                    Recordset As ADODB.Recordset) As Boolean
Dim oConn       As ADODB.Connection
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    PutRecordset = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'Get connection and set up for recordset
    If Connect <> vbNullString Then
        Set oConn = New ADODB.Connection
        oConn.Open Connect
    Else
        Set oConn = m_oConnection
    End If
    
    'connect to database and update records
    Set Recordset.ActiveConnection = oConn
    Recordset.UpdateBatch
    Set Recordset.ActiveConnection = Nothing
    If Connect <> vbNullString Then
        oConn.Close
    End If
    Set oConn = Nothing
    
    'signal success of function and we're out of here
    PutRecordset = True
    Exit Function

'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values
    lErrNo = Err.Number
    sErrDesc = Err.Description
    
    'close down what we can and raise error
    On Error Resume Next
    If Connect <> vbNullString Then
        oConn.Close
    End If
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              This function rolls back a previously begun transaction
'
'Function input:        Connect string which is a registered DSN. If supplied
'                       then previously established connection is closed
'Function output:       Returns TRUE if the function succeeds
'=======================================================================
Public Function RollbackTrans() As Boolean
Dim lErrNo      As Long
Dim sErrDesc    As String

    'assume failure
    RollbackTrans = False
    
    'enable error handler
    On Error GoTo ErrorHandler
    
    'roll back the transaction
    m_oConnection.RollbackTrans

    'signal closure of transaction, success of function and we're out of here
    m_bInsideTransaction = False
    RollbackTrans = True
    Exit Function
    
'if we're here there then's been an error so process
ErrorHandler:
    'store incoming values
    lErrNo = Err.Number
    sErrDesc = Err.Description
    
    'raise error
    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc

End Function

'=======================================================================
'Synopsis:              class terminator: closes connections
'=======================================================================
Private Sub Class_Terminate()

    'clean up any outstanding connections
    CloseConnection

End Sub


'=======================================================================
'Synopsis:              Function verifies data access component installation by
'                       attempting to instantiate an ado connection and recordset
'                       attempts to open connection connection string is supplied
'Function output:       Returns TRUE if successful
'=======================================================================
Public Function DataComponentsInstalled(Optional ByVal Connect As String) As Boolean
Dim oConn       As Object
Dim Recordset   As ADODB.Recordset
Dim lErrNo      As Long
Dim sErrDesc    As String
    
    'assume failure
    DataComponentsInstalled = False

    'enable error handler
    On Error GoTo ErrorHandler
    
    'default to false for function
    DataComponentsInstalled = False
    
    'see if we can create objects
    Set oConn = New ADODB.Connection
    Set Recordset = New ADODB.Recordset
    
    'if connection string passed in then attempt connection (BEST DETECTION METHOD)
    If Connect <> vbNullString Then
        oConn.Open Connect
        oConn.Close
    End If

    'objects instantiated without error so signal succes, clean up and exit
    Set Recordset = Nothing
    Set oConn = Nothing

    DataComponentsInstalled = True
    Exit Function

ErrorHandler:
    'store incoming values
    lErrNo = Err.Number
    sErrDesc = Err.Description
    
    'close down what we can and raise error
    On Error Resume Next
    Set Recordset = Nothing
    Set oConn = Nothing

    On Error GoTo 0
    Err.Raise lErrNo, OBJNAME, sErrDesc
End Function


